home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / BARNET / COMPILER / SATHER / !Sather / Library / Containrs / sa / fmap < prev    next >
Text File  |  1996-06-01  |  12KB  |  348 lines
  1. ---------------------------> Sather 1.1 source file <--------------------------
  2. -- Copyright (C) International Computer Science Institute, 1994.  COPYRIGHT  --
  3. -- NOTICE: This code is provided "AS IS" WITHOUT ANY WARRANTY and is subject --
  4. -- to the terms of the SATHER LIBRARY GENERAL PUBLIC LICENSE contained in    --
  5. -- the file "Doc/License" of the Sather distribution.  The license is also   --
  6. -- available from ICSI, 1947 Center St., Suite 600, Berkeley CA 94704, USA.  --
  7. --------> Please email comments to "sather-bugs@icsi.berkeley.edu". <----------
  8.  
  9. -- fmap.sa: Hash table based maps from objects to objects.
  10. -------------------------------------------------------------------
  11. class FMAP{K,T} < $STR is
  12.    -- Hash array based maps from key objects of type K to target 
  13.    -- objects of type T requiring writebacks. 
  14.    -- In this form void may not be a key, `key_nil' may be redefined.
  15.    -- If K is a subtype of $IS_EQ, then `is_eq' will be used for
  16.    -- key equality test (eg. string equality for STR), otherwise 
  17.    -- object equality is used. 
  18.    -- If K is a subtype of $HASH, then `hash' will be used for the hash
  19.    -- value, otherwise the element `id' will be used.
  20.    -- 
  21.    -- Implementation: May be inherited with `key_eq', `key_nil', and
  22.    -- `key_hash' redefined to get a different behavior.  The tables
  23.    -- grow by amortized doubling and so require writeback when
  24.    -- inserting and deleting elements.  We keep down the load factor
  25.    -- to cut down on collision snowballing.  The simple collision
  26.    -- resolution allows us to support deletions, but makes the
  27.    -- behavior quadratic with poor hash functions.  Puts a sentinel
  28.    -- at the end of the table to avoid one check while searching.
  29.     
  30.    private include COMPARE{T};
  31.    private include COMPARE{K} 
  32.      elt_eq->key_eq,elt_lt->,elt_hash->key_hash,
  33.      elt_nil->key_nil,is_elt_nil->is_key_nil;
  34.      
  35.    private include AREF{TUP{K,T}};
  36.     
  37.    private attr hsize:INT;    -- Number of stored entries.
  38.  
  39.    private const load_ratio:INT:=4; -- Allow to get at most 1/load_ratio full.
  40.  
  41.    -- We can't have an invariant here, because sometimes we want
  42.    -- to destroy 'self' for efficiency.
  43.  
  44.    --invariant:BOOL is        
  45.    --    -- Class invariant.
  46.    --    return void(self) or hsize.is_bet(0,asize) end;
  47.  
  48.    copy: SAME is
  49.       res ::= #SAME(size);
  50.       loop res := res.insert_pair(pair!) end;
  51.       res.hsize := hsize;
  52.       return res;
  53.    end;
  54.       
  55.    size:INT is 
  56.       -- Number of entries in the table. Self may be void.
  57.       if void(self) then return 0 else return hsize end end;
  58.     
  59.    create:SAME is return void end;
  60.  
  61.    create(n:INT):SAME 
  62.    -- Make a table capable of dealing with `n' elements without
  63.    -- expansion. You can simply insert into a void table to create 
  64.    -- one as well. Self may be void (and usually is).
  65.       pre n>=1 is 
  66.       return allocate(1.lshift((3*load_ratio*n/4).highest_bit+1)+1) end;
  67.  
  68.    private allocate(n:INT):SAME is
  69.       -- Allocate `n' locations (must be power of 2 plus 1) and
  70.       -- initialize to `(elt_nil,void)'.
  71.       r::=new(n); 
  72.       if ~void(key_nil) then loop r.aset!(#(key_nil,void)) end end;
  73.       return r end;
  74.     
  75.    target!:T is loop yield targets! end; end;
  76.    pair!:TUP{K,T} is loop yield pairs! end; end;
  77.    elt!: T is loop yield targets! end; end;
  78.    
  79.    pairs!:TUP{K,T} is
  80.       -- Yield the input/output pairs of self in an arbitrary order.
  81.       -- Do not insert or delete from self while calling this.
  82.       -- Self may be void.
  83.       if ~void(self) then
  84.      loop r::=aelt!; 
  85.         if ~is_key_nil(r.t1) then yield r end end end end;  
  86.     
  87.    keys!:K is
  88.       -- Yield the keys in self in an arbitrary order. Do not insert
  89.       -- or delete from self while calling this.
  90.       -- Self may be void.
  91.       if ~void(self) then
  92.      loop r::=aelt!.t1; 
  93.         if ~is_key_nil(r) then yield r end end end end;
  94.  
  95.    targets!:T is
  96.       -- Yield the target objects contained in self in an arbitrary
  97.       -- order. Do not insert or delete from self while calling this.
  98.       -- Self may be void.
  99.       if ~void(self) then
  100.      loop e::=aelt!; 
  101.         if ~is_key_nil(e.t1) then yield e.t2 end end end end;
  102.     
  103.    has_ind(k: K): BOOL is return test(k) end;
  104.    
  105.    test(k:K):BOOL is
  106.       -- True if the key `k' is mapped by self.
  107.       -- Self may be void.
  108.       if void(self) then return false end; 
  109.       h::=key_hash(k).band(asize-2);
  110.       loop tk::=[h].t1; 
  111.      if is_key_nil(tk) then break!
  112.      elsif key_eq(tk,k) then return true
  113.      end; 
  114.      h:=h+1 end;
  115.       if h=asize-1 then h:=0;    -- hit sentinel
  116.      loop tk::=[h].t1; 
  117.         if is_key_nil(tk) then break!
  118.         elsif key_eq(tk,k) then return true
  119.         end; 
  120.         h:=h+1 end;
  121.      assert h/=asize-1 end;
  122.       return false end;
  123.  
  124.    get(k:K):T is
  125.       -- If `k' is a key, return the corresponding target, otherwise
  126.       -- return void. Self may be void.
  127.       if void(self) then return void end; 
  128.       h::=key_hash(k).band(asize-2);
  129.       loop tk::=[h].t1; 
  130.      if is_key_nil(tk) then break!
  131.      elsif key_eq(tk,k) then return [h].t2
  132.      end; 
  133.      h:=h+1 end;
  134.       if h=asize-1 then h:=0;    -- hit sentinel
  135.      loop tk::=[h].t1; 
  136.         if is_key_nil(tk) then break!
  137.         elsif key_eq(tk,k) then return [h].t2
  138.         end; 
  139.         h:=h+1 end;
  140.      assert h/=asize-1 end; -- table mustn't be filled
  141.       return void end;
  142.     
  143.    get_pair(k:K):TUP{K,T} is
  144.       -- If `k' is a key, return the corresponding key/target pair.
  145.       -- Otherwise return #(key_nil,void). Useful when different
  146.       -- objects are treated as equal by `key_eq'. 
  147.       -- Self may be void.
  148.       if void(self) then return #(key_nil,void) end; 
  149.       h::=key_hash(k).band(asize-2);
  150.       loop tk::=[h].t1; 
  151.      if is_key_nil(tk) then break!
  152.      elsif key_eq(tk,k) then return [h]
  153.      end; 
  154.      h:=h+1 end;
  155.       if h=asize-1 then h:=0;    -- hit sentinel
  156.      loop tk::=[h].t1; 
  157.         if is_key_nil(tk) then break!
  158.         elsif key_eq(tk,k) then return [h]
  159.         end; 
  160.         h:=h+1 end;
  161.      assert h/=asize-1 end; -- table mustn't be filled
  162.       return #(key_nil,void) end;
  163.     
  164.    private double_size:SAME 
  165.    -- A new table of twice the size of self with self's entries
  166.    -- copied over. 
  167.       pre ~void(self) is
  168.       ns::=(asize-1)*2+1; r::=allocate(ns); 
  169.       loop r:=r.insert_pair(pairs!) end; 
  170.       SYS::destroy(self);    -- The old one should never be used now.
  171.       return r end;
  172.  
  173.    private should_grow:BOOL is
  174.       return (hsize+1)*load_ratio>asize;
  175.    end;
  176.  
  177.    insert(k:K,t:T):SAME is
  178.       -- A possibly new table which includes the key/target pair `k',
  179.       -- `t'. If `k' is already present, replaces the current key and 
  180.       -- target with `k,t'. Usage: `tbl:=tbl.insert(k,t)'. Creates a 
  181.       -- new table if void(self).
  182.       r::=self;
  183.       if void(r) then r:=allocate(5)
  184.       elsif should_grow then r:=double_size end;
  185.       orig_h::=r.key_hash(k).band(r.asize-2);
  186.       h::=orig_h;
  187.       asm::=r.asize-1;
  188.       loop tk::=r[h].t1; 
  189.      if is_key_nil(tk) then break! end;
  190.      if key_eq(tk,k) then r[h]:=#(k,t); return r end;
  191.      h:=h+1 end;
  192.       if h=asm then h:=0;    -- hit sentinel
  193.      loop tk::=r[h].t1; 
  194.         if is_key_nil(tk) then break! end;
  195.         if key_eq(tk,k) then r[h]:=#(k,t); return r end;
  196.         h:=h+1 end;
  197.      assert h/=asm end; -- table mustn't be filled     
  198.       assert not_too_many(orig_h,h); -- Look for excessive collisions
  199.       r[h]:=#(k,t); r.hsize:=r.hsize+1; return r end;
  200.  
  201.    private not_too_many(start, finish:INT):BOOL is
  202.       -- A function called in an assert to check that really
  203.       -- bad hashing isn't happening, which would probably
  204.       -- be a performance bug.  Since it is in an assert, this
  205.       -- isn't called unless checking is on.
  206.       if finish>start+50 then
  207.      #ERR+"Found a problem: excessive collisions in FMAP, probably\n"
  208.            +"due to a bad hash function in the class "
  209.            +SYS::str_for_tp(SYS::tp([start]))
  210.            +".\n";
  211.      k:K;
  212.      typecase k
  213.      when $STR then
  214.         #OUT + "Snowballing values:\n";
  215.         loop
  216.            i::=start.upto!(finish-1);
  217.            e::=[i].t1;
  218.            h::=key_hash(e);
  219.            typecase e
  220.            when $STR then
  221.           #OUT + i 
  222.             + '\t' + h.hex_str 
  223.             + '\t' + h.band(asize-2) 
  224.             + '\t' + e.str.pretty + '\n';
  225.            end;
  226.         end;
  227.      else
  228.      end;
  229.      return false;
  230.       end;
  231.       return true;
  232.    end;
  233.     
  234.    insert_pair(p:TUP{K,T}):SAME is
  235.       -- Insert the key/target pair held by the tuple arg.
  236.       -- If the key is already present, replaces it with the new
  237.       -- key and target. `tbl:=tbl.insert(p)'. Creates a new table 
  238.       -- if void(self).
  239.       return insert(p.t1,p.t2) end;
  240.     
  241.    private halve_size:SAME 
  242.    -- A new table of half the size of self with self's entries
  243.    -- copied over. 
  244.       pre ~void(self) and hsize<(asize-1)/4 is
  245.       ns::=(asize-1)/2+1; r::=allocate(ns); 
  246.       loop r:=r.insert_pair(pairs!) end; 
  247.       SYS::destroy(self);    -- The old one should never be used now.
  248.       return r end;
  249.  
  250.    private should_shrink:BOOL is
  251.       return asize>=33 and hsize<(asize-1)/(load_ratio*2);
  252.    end;
  253.     
  254.    delete(k:K):SAME is
  255.       -- A possibly new table which deletes the element with key 
  256.       -- `k' if it is contained in self. Usage: `tbl:=tbl.delete(k)'.
  257.       -- Self may be void.
  258.       if void(self) then return void end; 
  259.       h::=key_hash(k).band(asize-2);
  260.       loop tk::=[h].t1; 
  261.      if is_key_nil(tk) then return self
  262.      elsif key_eq(tk,k) then break! end;
  263.      if h=asize-2 then h:=0 else h:=h+1 end end;
  264.       [h]:=#(key_nil,void);    -- h is the index of arg
  265.       hsize:=hsize-1; i::=h; 
  266.       -- Now check the block after h for collisions.
  267.       loop 
  268.      if i=asize-2 then i:=0 else i:=i+1 end;
  269.      tk::=[i].t1; 
  270.      if is_key_nil(tk) then break! end; 
  271.      hsh::=key_hash(tk).band(asize-2);
  272.      if hsh<=i then        -- block doesn't wrap around
  273.         if h<i and h>=hsh then -- hole in way
  274.            [h]:=[i]; h:=i; [i]:=#(key_nil,void) end;
  275.      else            -- block wraps
  276.         if h>=hsh or h<i then -- hole in way
  277.            [h]:=[i]; h:=i; [i]:=#(key_nil,void) end end end;
  278.       if should_shrink then return halve_size
  279.       else return self end end;
  280.  
  281.    clear:SAME is
  282.       -- Clear out self, return the space if it has 17 or less entries
  283.       -- otherwise return void. Self may be void.
  284.       if void(self) then return void end;
  285.       if asize<=17 then r::=self; r.hsize:=0; 
  286.      loop aset!(#(key_nil,void)) end; return self
  287.       else return void end end;
  288.  
  289.    is_empty:BOOL is
  290.       -- True if the set is empty. Self may be void.
  291.       return void(self) or hsize=0 end;
  292.     
  293.    str: STR is 
  294.       res: FSTR := #("{");
  295.       i ::= 0; 
  296.       loop until!(i = asize);
  297.      p ::= [i];
  298.      if ~is_key_nil(p.t1) then
  299.         k::=p.t1; e ::=p.t2;
  300.         typecase k when $STR then res := res+"["+k.str+"]="; else end;
  301.         typecase e when $STR then res:= res+" "+e.str+" "; else end;
  302.         res := res+" ";
  303.      end;        
  304.      i := i + 1;
  305.       end;
  306.       res := res+"}";
  307.       return(res.str);
  308.    end;
  309.  
  310.    equals(e: $RO_MAP{K,T}): BOOL is
  311.       -- Returns true if all of "e"'s elements are equal to self's elts
  312.       -- Ordering is an issue. Should be redefined to be more
  313.       -- precise for particular descendants
  314.       -- This will not be a useful routine until we can place FMAP under
  315.       -- $RO_MAP 
  316.       if e.size /= size then return false end;
  317.       loop k ::= ind!;
  318.      a1 ::= get(k); a2 ::= e.aget(k);
  319.      if ~elt_eq(a1,a2) then return false end 
  320.       end;
  321.       return true
  322.    end;
  323.  
  324.    filter!(once f:ROUT{T}:BOOL): T  pre ~void(self) is
  325.       loop e ::= elt!; if f.call(e) then yield e end  end
  326.    end;
  327.  
  328.    filter_not!(once f:ROUT{T}:BOOL): T  pre ~void(self) is
  329.       loop e ::= elt!; if ~ f.call(e) then yield e end  end
  330.    end;
  331.  
  332.    ind!: K is loop yield keys! end; end;
  333.  
  334.    has(e:T):BOOL is
  335.       -- True if the self has an element which is `elt_eq' to `e'.
  336.       if void(self) then return false end;
  337.       loop if elt_eq(elt!,e) then return true end  end;
  338.       return false 
  339.    end;
  340.       
  341.    n_inds: INT    is 
  342.       if void(self) then return 0 else return hsize end 
  343.    end;
  344.    
  345. end; -- class FMAP{K,T}
  346.  
  347. -------------------------------------------------------------------
  348.